home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / utils / atomic-extents.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  3.9 KB  |  116 lines
  1. ;;; atomic-extents.el --- treat regions of text as a single object
  2.  
  3. ;; Copyright (C) 1993 Free Software Foundation, Inc.
  4. ;; Created: 21-Dec-93, Chuck Thompson <cthomp@cs.uiuc.edu>
  5. ;; Keywords: extensions
  6. ;; Changed: 08-Aug-94, Heiko Muenkel <muenkel@tnt.uni-hannover.de>
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Point is not allowed to fall inside of an atomic extent.  This has
  25. ;;; the effect of making all text covered by an atomic extent be
  26. ;;; treated as a single object.  Normally point will be adjusted to an
  27. ;;; end of an atomic extent in the direction of motion.  If point
  28. ;;; appears inside of an atomic extent (via goto-char for example),
  29. ;;; point will be adjusted to the side closest to the entry point.
  30.  
  31. ;;; To make an extent atomic use the command:
  32. ;;;    (set-extent-property #<extent obj> 'atomic t)
  33.  
  34. ;;; Known bug: the atomic property is not detected when sweeping
  35. ;;; regions with the mouse until after the mouse button is released.
  36. ;;; The release point will then be treated as if it had been reached
  37. ;;; using 'goto-char.
  38.  
  39. ;;; atomic-extent-goto-char-p is defined in editfns.c
  40.  
  41. (provide 'atomic-extents)
  42.  
  43. (defvar atomic-extent-old-point nil
  44.   "The value of point when pre-command-hook is called.
  45. Used to determine the direction of motion.")
  46.  
  47.  
  48. (defvar atomic-extent-old-mark nil
  49.   "The value of mark when pre-command-hook is called.
  50. Used to determine the direction of motion.")
  51.  
  52.  
  53. (defun atomic-extent-pre-hook ()
  54.   (setq atomic-extent-old-point (point))
  55.   (setq atomic-extent-goto-char-p nil)
  56.   (setq atomic-extent-old-mark (mark)))
  57.  
  58.  
  59. (defun atomic-extent-post-hook ()
  60.   (let ((extent (extent-at (point) nil 'atomic)))
  61.     (if extent
  62.     (let ((begin (extent-start-position extent))
  63.           (end (extent-end-position extent))
  64.           (pos (point))
  65.           (region-set (and (point) (mark))))
  66.       (if (eq this-command
  67.           'x-set-point-and-insert-selection)
  68.           (delete-region (region-beginning) (region-end)))
  69.       (if (/= pos begin)
  70.           (if atomic-extent-goto-char-p
  71.           (progn
  72.             (if (> (- pos begin) (- end pos))
  73.             (goto-char end)
  74.               (goto-char begin)))
  75.         (if (> pos atomic-extent-old-point)
  76.             (goto-char end)
  77.           (goto-char begin))))
  78.       (if (and region-set (/= pos begin))
  79.           (progn
  80.         (run-hooks 'zmacs-update-region-hook)
  81.         (x-store-cutbuffer (buffer-substring (region-beginning)
  82.                              (region-end)))
  83.         )))))
  84.   (if (mark)
  85.       (progn
  86.     (exchange-point-and-mark t)
  87.     (let ((extent (extent-at (point) nil 'atomic)))
  88.       (if extent
  89.           (let ((begin (extent-start-position extent))
  90.             (end (extent-end-position extent))
  91.             (pos (point))
  92.             (region-set (and (point) (mark))))
  93.         (if (/= pos begin)
  94.             (if atomic-extent-goto-char-p
  95.             (progn
  96.               (if (> (- pos begin) (- end pos))
  97.                   (goto-char end)
  98.                 (goto-char begin)))
  99.               (if (> pos atomic-extent-old-point)
  100.               (goto-char end)
  101.             (goto-char begin))))
  102.         (if (and region-set (/= pos begin))
  103.             (progn
  104.               (run-hooks 'zmacs-update-region-hook)
  105.               (x-store-cutbuffer (buffer-substring (region-beginning)
  106.                                (region-end)))
  107.         (message "%d, %d" (region-beginning) (region-end))
  108.               )))))
  109.     (exchange-point-and-mark t)))
  110.   )
  111.  
  112. (add-hook 'pre-command-hook 'atomic-extent-pre-hook)
  113. (add-hook 'post-command-hook 'atomic-extent-post-hook)
  114.  
  115. ;;; atomic-extents.el ends here
  116.